home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / aplibs91.zip / ERFIND.BAS < prev    next >
BASIC Source File  |  1991-06-28  |  8KB  |  228 lines
  1.  
  2. '          ╔═════════════════════════════════════════════════════╗
  3. '          ║                E R F I N D . B A S                  ║
  4. '          ║                                                     ║
  5. '          ║    THE PROGRAMMER'S FRIEND ... FOR QEDIT USERS      ║
  6. '          ╚═════════════════════════════════════════════════════╝
  7.  
  8. '  WAT ?? Well, here's the deal. I usually use PBC to complile my Power
  9. '         Basic programs due to the file sizes involved, and edit them with
  10. '         the very fine shareware editor QEdit. QEdit can jump on load to
  11. '         a given file line -- but how could I get the error info from my
  12. '         screen to the command line (other than manually, of course) ??
  13. '         Well, PB can read the screen buffer just fine. But it took me a lot
  14. '         of tinkering to create ERFIND.BAS, to take that info off the screen,
  15. '         get the line #, make it into a batch file, and then stuff the
  16. '         keyboard buffer with the batch file's name so that when ERFIND is
  17. '         done, the batch file starts automatically !!
  18.  
  19. '     USAGE: START WITH A BATCH FILE LIKE  'pq.bat'. THIS CALLS FIRST THE
  20. '            COMPILER, THEN IF ERRLEVEL > 0 ERFIND IS CALLED. THEN THE NEW
  21. '            BATCH FILE, CREATED ON THE FLY, STARTS THE PROCESS ALL OVER AGAIN.
  22.  
  23.                                $COMPILE EXE
  24.                             $OPTION CNTLBREAK OFF
  25.  DEFINT A-Z
  26.  DIM STATIC DispLine$ (25)
  27.  RD$ = ENVIRON$ ("TEMP") + ":" '            My environment contains the RamDisk
  28.  PRINT RD$: DELAY 2
  29.  '                                          designator, eg SET TEMP=D, as a home
  30.  '                                          for temporary files
  31.  CALL ReadNMatchColor '            set print color to = screen color @ cursor
  32.  DEFINT A-Z
  33.  
  34. ''' dbg = -1 '                                if true, 'dbg' creates an output
  35. '                                             file to help sort out the results.
  36.  IF dbg THEN
  37.    Debug = FREEFILE
  38.    OPEN "READSCRN.DBG" FOR APPEND AS #Debug
  39.    PRINT #Debug, "READSCRN -- "; TIME$; "  "; DATE$
  40.    PRINT #Debug, "  COMMAND$ = <"; COMMAND$; ">"
  41.  END IF
  42.  
  43.  
  44.  IF dbg THEN
  45.    PRINT #Debug, "  RD$ = "; RD$
  46.  END IF
  47.  
  48.  '                                                        read the screen
  49.  FOR L = 1 TO 25 '                                        into a string array
  50.    DispLine$ (L) = SCRNLINE$ (L)
  51.  NEXT
  52.  
  53.  LOCATE CSRLIN + 2, 1
  54.  '                                                   find the last nonblank line
  55.  FOR L = 25 TO 1 STEP -1 '                           (starting from the bottom)
  56.   IF RTRIM$ (DispLine$ (L)) <> "" THEN
  57.     A$ = DispLine$ (L)
  58.     EXIT FOR
  59.   END IF
  60.  NEXT
  61.  
  62. '                                               if it doesn't say 'Error' or
  63. '                                               'Target', check the next line up
  64. '                                               (since a long error-description
  65. '                                               may have caused the message to
  66. '                                               wrap to a second line ...)
  67.  
  68.  IF INSTR (A$, "): Error ") + INSTR (A$, "): Target ")  = 0 THEN
  69.    DECR L
  70.    A$ = DispLine$ (L)
  71.  END IF
  72.  
  73.  IF dbg THEN
  74.    PRINT #Debug, "  A$ = "; RTRIM$ (A$)
  75.  END IF
  76.  
  77.  IF INSTR (A$, "): Error ") + INSTR (A$, "): Target ")  = 0 THEN
  78.    PLAY "O4 C32 P16 O0 F64"
  79.    PRINT "Erfind: NO ERROR FOUND. EXITING TO SYSTEM."
  80.    IF dbg THEN
  81.      PRINT #Debug, "          NO ERROR FOUND. EXITING TO SYSTEM."
  82.      PRINT #Debug, ""
  83.    END IF
  84.    END 1
  85.  END IF
  86.  
  87. '                            check whether we're dealing with the output of
  88. '                            a 'PBC /REnnnn' command ... if so the screen reads
  89. '                            "Target address found" rather than "Error". (This
  90. '                            means a run-time error; it won't happen unless your
  91. '                            main program has an error handler that makes it
  92. '                            happen -- e.g. the upcoming Spring '91 revision of
  93. '                            APLIB, the All-Purpose PowerBASIC Lirary.)
  94. '
  95.  
  96.  UsingPBCREOutPut = (INSTR (A$, "Target") > 0)
  97.  
  98.  DO WHILE INSTR (A$, "\") '                           parse off the path string
  99.    A$ = MID$ (A$, INSTR (A$,"\")+1)
  100.  LOOP
  101.  
  102.  E$ = MID$ (A$, INSTR(A$, "Error") + 6) '                 get the error number
  103.  ECode = VAL (E$)
  104.  
  105.  FileName$ = EXTRACT$ (A$, "(") '                             get the file name
  106.  LineNum = VAL (EXTRACT$ (MID$ (A$, LEN(FileName$)+2), ")")) '    & line number
  107.  Extension$ = MID$ (A$, INSTR (A$, ".") + 1, 3)
  108.  Extension$ = EXTRACT$ (Extension$, "(")
  109.  FileName$ = EXTRACT$ (FileName$, ".") + "." + Extension$
  110.  
  111.  IF dbg THEN
  112.    PRINT #Debug, "  ERROR "; ECode; " IN "; FileName$; " LINE "; LineNum
  113.    PRINT #Debug, ""
  114.  END IF
  115.  
  116.  IF NOT UsingPBCREOutPut THEN
  117.    LOCATE 25,30: PRINT "PRESS  A KEY TO RETURN TO EDITOR ... ";
  118.    DO: LOOP UNTIL INKEY$ <> ""
  119.  END IF
  120.  LOCATE 25,1: PRINT SPACE$ (80);
  121.  LOCATE 25,1
  122.  
  123.  IF RD$ = ":" THEN
  124.    CLS
  125.    LOCATE 5, 1
  126.    PRINT "         ====================================================="
  127.    PRINT "         A drive or path for saving temporary files was not
  128.    PRINT "         found in your DOS environment string. You can put it
  129.    PRINT "         there later by typing 'SET TEMP=D' or E or whatever
  130.    PRINT "         the drive letter of your RAM-Disk is. If you don't have
  131.    PRINT "         a RAM-Disk, a regular disk drive may be used instead;
  132.    PRINT "         you will want to delete the temporary .BAT files 
  133.    PRINT "         later. For now, enter the drive letter to use.
  134.    PRINT "            DRIVE & PATH FOR TEMPORARY FILES IS: ";
  135.    L = CSRLIN: C = POS
  136.    PRINT "         ====================================================="
  137.    LOCATE L,C: INPUT C$
  138.    LOCATE L+1, 79: PRINT: PRINT
  139.    C$ = UCASE$ (LEFT$ (C$, 1))
  140.    IF C$ < "A" OR C$ > "Z" THEN
  141.      BEEP: PRINT "ERROR!": END 1
  142.    ELSE
  143.      RD$ = C$ + ":"
  144.    END IF
  145.  END IF
  146.  
  147.  IF DIR$ (RD$ + "GO2ERR.&BA") <> "" THEN KILL RD$ + "GO2ERR.&BA"
  148.  IF DIR$ (RD$ + "GO2ERR.BAT") <> "" THEN
  149.    NAME RD$ + "GO2ERR.BAT" AS RD$ + "GO2ERR.&BA"
  150.  END IF
  151.  OPEN RD$ + "GO2ERR.BAT" FOR OUTPUT AS 1 '        create output batch-file
  152.  A$ = "@echo off"
  153.  PRINT #1, A$
  154.  A$ = "Q " + FileName$ + " /n" + LTRIM$ (STR$ (LineNum))
  155.  PRINT #1, A$
  156.  A$ ="check keyboard"
  157.  PRINT #1, A$
  158.  A$ ="if errorlevel 1 quit"
  159.  PRINT #1, A$
  160.  IF DIR$ (RD$ + "colorcls.com") <> "" THEN '       My EGA machine has PC 
  161.    A$ = RD$ + "colorcls 4E" '                      Magazine's COLORCLS.COM
  162.  ELSE '                                            stored on the ramdisk
  163.    A$ ="cls"
  164.  END IF
  165.  PRINT #1, A$
  166.  
  167.  IF COMMAND$ = "" THEN
  168.    A$ = "pbc /ce " + FileName$
  169.  ELSE
  170.    A$ ="pbc /ce " + COMMAND$
  171.  END IF
  172.  PRINT #1, A$
  173.  
  174.  A$ ="if not errorlevel 1 goto OK"
  175.  PRINT #1, A$
  176.  A$ ="erfind " + COMMAND$
  177.  PRINT #1, A$
  178.  A$ ="quit"  '
  179.  PRINT #1, A$
  180.  A$ ="goto end"
  181.  PRINT #1, A$
  182.  A$ =":OK"
  183.  PRINT #1, A$
  184.  F$ = EXTRACT$ (COMMAND$, ".")
  185.  A$ = "if exist " + F$ + ".EXE " + COMMAND$
  186.  PRINT #1, A$
  187.  A$ = "if exist \bin\nul if exist \bin\" + F$ + ".EXE " + F$
  188.  PRINT #1, A$
  189.  A$ =":end"
  190.  PRINT #1, A$
  191.  
  192.  CLOSE
  193.  CALL BufferStuffer (RD$ + "GO2ERR" + CHR$(13))
  194.  END
  195.  
  196.  FUNCTION SCRNLINE$ (L)
  197.    LOCAL Ct
  198.    LOCAL A$
  199.    A$ = ""
  200.    FOR Ct = 1 TO 80
  201.      A$ = A$ + CHR$ (SCREEN (L, Ct))
  202.    NEXT
  203.    SCRNLINE$ = A$
  204.    END FUNCTION
  205.  
  206.   SUB BufferStuffer (M$)
  207.   IF LEN (M$) > 15 THEN PLAY "O2 E32 P8 O1 C4": M$ = "COMMAND"+CHR$(255)+"2 LONG"
  208.   L = LEN (M$)
  209.   DEF SEG = 0
  210.   POKE 1050, 30
  211.   POKE 1052, 30 + 2 * L
  212.   FOR I = 1 TO L
  213.     POKE 1052 + 2*I, ASCII (MID$ (M$,I,1))
  214.   NEXT
  215.  
  216.   END SUB
  217. '         ___________________________________________________________
  218.  
  219. SUB ReadNMatchColor
  220.  LOCAL A        '                                  sets COLOR to match the
  221.  A = SCREEN (CSRLIN, POS, 1) '                     color presently on the
  222.  COLOR A MOD 16, A \ 16 '                          display (at cursor position).
  223. END SUB
  224. '         __________________  END OF PROGRAM  _____________________
  225.  
  226.  
  227.  
  228.